perm filename TESSEL.SAI[SAI,BGB] blob
sn#100500 filedate 1974-05-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "TESSEL"
C00004 00003 SUBR PROJECT
C00005 00004 SUBR ROTATE (REAL DELITG AXIS)
C00006 00005 α MAIN EXECUTION
C00007 ENDMK
C⊗;
BEGIN "TESSEL"
REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
REQUIRE "DPYIII[SYS,BGB]" SOURCE_FILE;
SAFE ITG ARRAY DPYBUF[0:600];
REAL ARRAY W,X,Y,Z[1:16];
REAL ARRAY XWC,YWC,ZWC[1:16];
REAL ARRAY XPP,YPP,ZPP[1:16];
ITG ARRAY PVT,NVT[1:32]; α EDGES;
ITG V,E,I,J,K,L;
REAL RDEL;
SUBR INIT;
BEGIN "INIT"
V←0;
RDEL ← π/8;
FOR I←-1,1 DO FOR J←-1,1 DO
FOR K←-1,1 DO FOR L←-1,1 DO
⊂ V←V+1;W[V]←I; X[V]←J; Y[V]←K; Z[V]←L ⊃;
FOR I←1 THRU 8 DO ⊂ NVT[I]←I;PVT[I]←I+8;⊃;
E←8;
FOR I←1 STEP 2 UNTIL 15 DO ⊂ E←E+1;NVT[E]←I;PVT[E]←I+1;⊃;
FOR I←1 THRU 4 DO ⊂ E←E+1;NVT[E]←I;PVT[E]←I+4;⊃;
FOR I←9 THRU 12 DO ⊂ E←E+1;NVT[E]←I;PVT[E]←I+4;⊃;
FOR I←1,2,5,6,9,10,13,14 DO ⊂ E←E+1;NVT[E]←I;PVT[E]←I+2;⊃;
END "INIT";
SUBR PROJECT;
BEGIN "PROJECT"
FOR I←1 THRU 16 DO
⊂ XWC[I] ← 20*X[I] / (W[I]+5);
YWC[I] ← 20*Y[I] / (W[I]+5);
ZWC[I] ← 20*Z[I] / (W[I]+5);
XPP[I] ← 1000*XWC[I]/(ZWC[I]-20);
YPP[I] ← 1000*YWC[I]/(ZWC[I]-20);
⊃;
END "PROJECT";
SUBR DPY;
BEGIN "DPY"
DPYSET(DPYBUF);
FOR E←1 THRU 32 DO
⊂ AIVECT(XPP[PVT[E]],YPP[PVT[E]]);
AVECT(XPP[NVT[E]],YPP[NVT[E]]);⊃;
DPYOUT(1);
END "DPY";
SUBR ROTATE (REAL DEL;ITG AXIS);
BEGIN "ROTATE"
REAL C,S,XX,YY,TMP;
C ← COS(DEL); S ← SIN(DEL);
FOR I←1 THRU 16 DO
BEGIN
XX ← CASE AXIS OF (Y[I],Z[I],X[I],W[I],W[I],W[I]);
YY ← CASE AXIS OF (Z[I],X[I],Y[I],X[I],Y[I],Z[I]);
TMP ← C*XX - S*YY;
YY ← C*YY + S*XX;
XX ← TMP;
CASE AXIS OF ⊂ Y[I]←XX;Z[I]←XX;X[I]←XX;W[I]←XX;W[I]←XX;W[I]←XX; ⊃;
CASE AXIS OF ⊂ Z[I]←YY;X[I]←YY;Y[I]←YY;X[I]←YY;Y[I]←YY;Z[I]←YY; ⊃;
END;
END "ROTATE";
α MAIN EXECUTION;
INIT;
WHILE TRUE DO
BEGIN "LISTEN"
ITG Q,CHR;
PROJECT;DPY;
CHR ← INCHRW;
IF (CHR LAND '400)≠0 THEN Q←3 ELSE Q←0;
CHR ← CHR LAND '177;
IF CHR=":" THEN ROTATE(RDEL,0+Q) ELSE
IF CHR=")" THEN ROTATE(RDEL,1+Q) ELSE
IF CHR="*" THEN ROTATE(RDEL,2+Q) ELSE
IF CHR=";" THEN ROTATE(-RDEL,0+Q) ELSE
IF CHR="(" THEN ROTATE(-RDEL,1+Q) ELSE
IF CHR="-" THEN ROTATE(-RDEL,2+Q) ELSE
IF CHR="/" THEN RDEL←RDEL/2 ELSE
IF CHR="\" THEN RDEL←RDEL*2;
END "LISTEN";
END "TESSEL";